COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	integer jfn
C00006 00003	Output codes for Press
C00017 ENDMK
C⊗;
integer jfn;
integer cellsize, cellsh;
boolean rotated;
integer recnum, outcount # current record and byte numbers;
define maxparts=400;
saf integer array partdir[0:2*maxparts];
integer pdptr, nparts # byte pointer into partdir, number of parts;

define micasPerInch=⊂2540⊃;
define pageheight=11*micasPerInch, pagewidth=8.5*micasPerInch;

comment Procedures for 8-bit-byte file I/O;
define byteSizeShift=30 # shift for byte-size field in arg to openf;
define readAccess='200000, writeAccess='100000, appendAccess='20000;

comment the following two procedures do 8-bit byte output to a file
that has been appropriately opened for 8-bit transfers. jfn is the
full tenex jfn for the file [jfn ← cvjfn(chan)];

simple procedure Bout(integer byte);
	begin comment output an 8-bit byte;
	define bout=⊂jsys '51⊃;
		start_code
		move 1,jfn # destination;
		move 2,byte # the byte;
		bout;
		end;
	outcount←outcount+1;
	end;

simple procedure Wout(integer word);
	begin
	Bout(word lsh -8); Bout(word);
	end;

simple procedure Sout(integer ptr, bytecount);
	begin comment output a string of 8-bit bytes;
	if not(bytecount>0) then return # (-bytecount) must be negative!;
	define sout=⊂jsys '53⊃;
		start_code
		move 1,jfn # destination;
		move 2,ptr # string pointer;
		movn 3,bytecount # negative byte count;
		sout;
		end;
	outcount←outcount+bytecount;
	end;

simple integer procedure Bptr(reference integer base; integer byte);
	begin
	integer loc, b, p, ptr;
	define s=8;
	loc←location(base)+(byte div 4);
	b←byte mod 4;
	p←36-b*s;
	ptr←(((p lsh 6)+s) lsh 24)+loc;
	return(ptr);
	end;

simple integer procedure PadRecord(integer padval);
	begin
	integer padlength, i;
	padlength←-(outcount mod 512);
	if padlength<0 then padlength←padlength+512;
	for i←1 thru padlength do Bout(padval);
	return(padlength);
	end;

simple procedure BCPLout(string s; integer maxbytes);
	begin
	integer len, i;
	len←(maxbytes-1) min length(s);
	Bout(len);
	for i←1 thru maxbytes-1 do
		if i<=len then Bout(s[i to i]) else Bout(0);
	end;

comment Output codes for Press;


comment Press Entity list commands;
define
	ELShowCharactersShort = '0,
	ELSetSpaceXShort = '140,
	ELFont = '160,
	ELSetX = '356,
	ELSetY = '357,
	ELShowCharacters = '360,
	ELSetSpaceX = '364,
	ELResetSpace = '366,
	ELSetBrightness = '370,
	ELSetHue = '371,
	ELSetSaturation = '372,
	ELShowRectangle = '376,
	ELNop = '377;

comment entity 1 removed;
define d0max=10000, e0max=30000;
comment max permissible data list, entity list counts (bytes);
define d0len=d0max div 4, e0len=e0max div 4;
saf integer array dl0[0:d0len];
saf integer array el0[0:e0len];
integer dlp, elp;
DEBUGONLY integer dlmaxused # max attained data list count (bytes);
DEBUGONLY integer elmaxused # max attained entity list count (bytes);
integer dct, ect, pch, cx, cy, cf;

comment Procedures for dealing with DL and EL;

simple procedure StartPage;
	begin
	comment initialize byte pointers into DL and EL;
	dlp←point(8, dl0[0], -1);
	elp←point(8, el0[0], -1);
	dct←0; ect←0; pch←0; cx←0; cy←0; cf←0;
	end;

simple procedure ELByte (integer b);
	begin
	if ect≥e0max then overflow(ect);
	idpb(b, elp);
	ect←ect+1;
	end;

simple procedure ELWord (integer w);
	begin ELByte(w lsh -8); ELByte(w) end;

simple procedure ELDWord (integer d);
	begin ELWord(d lsh -16); ELWord(d) end;

simple procedure DLByte (integer b);
	begin
	if dct≥d0max then overflow(dct);
	idpb(b, dlp);
	dct←dct+1;
	end;

simple procedure DLWord (integer w);
	begin DLByte(w lsh -8); DLByte(w) end;

simple procedure AddPart(integer parttype, beginrec, nrecs, pad(0));
	begin
	if nparts≥maxparts then overflow(nparts);
	idpb(parttype, pdptr);
	idpb(beginrec, pdptr);
	idpb(nrecs, pdptr);
	idpb(pad, pdptr);
	nparts←nparts+1;
	end;

simple procedure PutChar(integer c);
	begin
	DLByte(c); pch←pch+1;
	end;

simple procedure Flush;
	begin
	short integer n;
	n←pch;
	if n>0 then
		begin
		if n≤32 then ELByte(ELShowCharactersShort+n-1)
		else while n>0 do begin
			ELByte(ELShowCharacters); ELByte(n min 255);
			n←n-255;
		end;
		pch←0;
		end;
	end;

simple procedure SetX(integer x);
	begin
	Flush; ELByte(ELSetX); ELWord(x);
	end;

simple procedure SetY(integer y);
	begin
	y←pageheight-y # invert y direction;
	Flush; ELByte(ELSetY); ELWord(y);
	end;

simple procedure SetHue(integer x);
	begin Flush; ELByte(ELSetHue); ELByte(x);
	end;

simple procedure SetBrightnessAndSaturation;
	begin Flush; ELByte(ELSetBrightness); ELByte('377) # white;
	ELByte(ELSetSaturation); ELByte('377) # totally saturated;
	end;

simple procedure PutRectangle(integer x0,y0,h,w);
	begin comment x0,y0 specify the upper left corner;
	comment en←1 # put all rectangles in entity 1;
	Flush;
	SetX(x0); SetY(y0+h);
	ELByte(ELShowRectangle); ELWord(w); ELWord(h);
	end;

simple procedure SetFont(integer f);
	begin
	if cf≠f then begin Flush; ELByte(ELFont+(cf←f)); end;
	end;

comment append a trailer to entity list n;
simple procedure ETrailer(integer n, beginbyte, bytelength);
	begin
	Flush # don't forget to flush out pending characters!;
	if ect=0 then return # empty entity - leave it empty;
	if (ect mod 2) ≠ 0 then ELByte(ELNop) # pad to word boundary;
	ELByte(125) # type;
	ELByte(0) # font set;
	ELDWord(beginbyte) # beginning of DL region;
	ELDWord(bytelength) # length of DL region;
	ELWord(0); ELWord(0) # origin (Xe, Ye);
	ELWord(0); ELWord(0) # bottom left corner of bounding box;
	ELWord(pagewidth); ELWord(pageheight) # dimensions of bounding box;
	ELWord(ect div 2+1) # entity length in WORDS (including this number);
	comment Assertion: the entity now contains an even number of bytes;
	end;

define outch(c)=⊂PutChar((c)land '177)⊃ # macro for output of a single character;
simple procedure outchs(string str);
begin integer i;
for i←1 step 1 until length(str) do outch(str[i for 1])
end;
define outrule(x0,y0,h,w)=⊂PutRectangle(x0,y0,h,w)⊃;
define newfont(f)=⊂SetFont(f)⊃;

procedure finproofchar # the main output procedure,produces one page;
begin
short integer y0prev,i,cutplace;
integer padbytes, nextrec;

comment all new code here for Press;
comment write data lists;
Sout(Bptr(dl0[0],0), dct);
if (outcount mod 2) ≠ 0 then Bout(0) # pad to word boundary;

comment construct entity trailers;
ETrailer(0, 0, dct);

Wout(0) # zero word to mark beginning of entity lists;
comment write entity lists;
Sout(Bptr(el0[0],0), ect);
padbytes←PadRecord(ELNop);

nextrec←outcount div 512;
AddPart(0, recnum, nextrec-recnum, padbytes div 2) # want WORDS of padding;
recnum←nextrec;

DEBUGONLY		dlmaxused←dlmaxused max dct;
DEBUGONLY		elmaxused←elmaxused max ect;

end;

procedure proofcloseout # just before TEX stops, do this;
begin integer n,f;
integer nextrec, logdir, dummy, pdlen, time, i;
string letters; integer lbt;

comment write the font directory part;
define entrylength=16 # in WORDS!!!;

for f←0 thru 1 do 
	begin
	Wout(entrylength);
	Bout(0) # font set;
	Bout(f) # font number within set;
	Bout(0); Bout('177) # first and last characters;
	comment family name is a bcpl string, max 20 bytes;
	BCPLout(if f=0 then "TIMESROMAN" else "FIG", 20);
	Bout(0) # face;
	Bout(0) # "source" character;
	Wout(if f=0 then 6 else if rotated then cellsize else cellsize+1)
	 # should really be in micas, but PressEdit doesn't understand;
	Wout(if f=1 and rotated then 5400 else 0) # rotation;
	end;
Wout(0) # a zero word to mark the end of the font directory!;
PadRecord(0);
nextrec←outcount div 512;
AddPart(1, recnum, nextrec-recnum);
recnum←nextrec;

comment write the part directory;
pdlen←8*nparts # 4 words (8 bytes) per part;
Sout(Bptr(partdir[0], 0), pdlen);
PadRecord(0);
nextrec←outcount div 512;

comment now, finally, the document directory;
Wout(27183) # general password;
Wout(nextrec+1) # total number of records in file (including this one);
Wout(nparts) # number of parts;
Wout(recnum) # start of part dir;
Wout(nextrec-recnum) # number of records in part dir;
Wout(-1) # back-pointer to obsolete document directory(?);
time←gtad # current date and time (tenex-style);
time←((time lsh -18)-15385)*(3600*24)+(time land '777777) # Alto-style time;
Wout(time lsh -16); Wout(time);
Wout(1); Wout(1) # first and last copy;
Wout(-1); Wout(-1) # first and last pages;
Wout("S") # printing mode is "solid";
comment That "S" also makes Viola send bit map instead of characters;
for i←13 thru '177 do Wout(-1);
BCPLout(ofilname, 2*26);
gjinf(logdir,dummy,dummy);
BCPLout(dirst(logdir), 2*16);
BCPLout(odtim(-1,'202301000000), 2*20);
PadRecord(0);

end;